Carousel Volume 2 #1/carousel.iso/mactosh/postscri/lwheader.doc/LWHEADERFILE.DOC/LASERWRITER-HEADER.PS.1

Text File | 1988-10-25 | 25KB | 1,044 lines

%!
%         Macintosh LaserWriter header file.
%
% This is a file of PostScript definitions that can be affixed to the
% front of the PostScript files generated by Macintosh applications in order
% that they can be printed on a LaserWriter that has not been initialized
% with the "LaserPrep" package. This situation will arise if you are
% trying to share a LaserWriter between Macintosh users and non-Macintosh
% users.
%
% Macintosh applications do not normally generate straight PostScript.
% They generate a file in PostScript format, but the contents of the file
% is a series of calls on functions that are not part of the PostScript
% language. This file defines those functions.
%
% This is not the official Apple header file. It is neither endorsed nor
% condemned by Apple. I suspect that it probably started out its life
% as a bootleg copy of a version of the Apple header file. It has been
% slightly modified by me and perhaps heavily modified by various other
% people. I have substantially augmented the comments so that they explain
% what I think the code is doing.
%
%    Brian Reid    [e-mail]
%    Stanford    {decwrl,hplabs,bellcore}!glacier!reid
%
% WARNING: There is no guarantee that Apple will stick to this particular
% set of definitions. This header file works with the application software
% that came with my LaserWriter; I make no promises that it will work with
% the software on anybody else's LaserWriter.
%
% To convert this file back into a downloaded file instead of a header
% file, uncomment all of the lines beginning with %-%

%-%0000000             % Server loop exit password
%-%serverdict begin exitserver
%-%  systemdict /statusdict known
%-%  {statusdict begin 9 0 3 setsccinteractive /waittimeout 300 def end}
%-% if
/md 200 dict def        % define a working dictionary
md begin            % start using it
/av 13 def            % define apple version
/mtx matrix currentmatrix def    % save current transformation
/s30 30 string def
/s1 ( ) def
/pys 1 def
/pxs 1 def
/pyt 760 def
/pxt 29.52 def
/por true def
/xl {translate} def
/fp {pnsh 0 ne pnsv 0 ne and} def

% Define QuickDraw operators as an array of procedures.
% They are {frame, paint, erase, invert, fill}
% For some reason "invert" is a no-op.

/vrb [
{fp
 {gsave 1 setlinewidth pnsh pnsv scale stroke grestore}
 if newpath}
{eofill}
{eofill}
{newpath}
{eofill}
{initclip eoclip newpath}
{}
{}
{}
{}
] def

% convenience function for backwards def
/xdf {exch def} def

% get current halftone screen parameters
currentscreen
    /spf xdf        % spot function
    /rot xdf        % rotation
    /freq xdf        % spatial frequency

% "apply" function to execute appropriate numbered operator from /vrb.
/doop {vrb exch get exec} def

% compute page position from portrait/landscape flag, translation, scale,
%    and resolution.
%  call: P/L-flag xtransl ytransl scale*100 xbits/inch ybits/inch psu
% typical call: F 580 760 100 72 72 psu for life-size screen-resolution
% image.
%
/psu
  {2 index .72 mul exch div /pys xdf    % pixel y scale
  div .72 mul /pxs xdf            % pixel x scale
 /pyt xdf                % pixel y translation
 /pxt xdf                % pixel x translation
 /por xdf                % portrait flag (T=portrait)
} def

% argument is page y size; use this to determine legal, letter, or note
% and to set up appropriate scale factors and translation/reflection
% for portrait or landscape.

/txpose{
    dup 1680 eq
    userdict /note known
      {{legal}{note}ifelse}
      {pop}
    ifelse
    dup 1212 eq {54 32.4 xl} if
    1321 eq {8.64 -.6 xl} if
    pxs pys scale pxt pyt xl por not
    {270 rotate} if
    1 -1 scale
} def

% Compute oblique shear value for font if flag true
/obl {{0.212557 mul}{pop 0} ifelse} def

%  set font from dictionary: make a font, set it to current, leave on stack
%  call: "found-font size oblique-flag dictionary sfd"
/sfd {
   [ps 0 ps 6 -1 roll obl ps neg 0 0] makefont
   dup setfont
} def
/fnt {findfont sfd} def

% bit test-- "number mask-word bt" returns boolean and unchanged number
% thus, "4095 512 bt" returns "true 4095" -- the argument is a mask
% and not a bit number.

/bt {1 index and 0 ne exch} def

% load style array with unpacked true/false flags from style word
% flags are Bold, Italic, Underline, Outline, Shadow (I don't know
% what the 6th one is supposed to be).
/sa 6 array def
/fs {
    1 bt     2 bt    4 bt    8 bt   16 bt
   sa astore pop
} def

/matrix1 matrix def
/matrix2 matrix def
/gf{
  currentfont
} def

% set translation center from 2 double-precision integers giving x,y
/tc{
   32768 div add         % compute y location
   3 1 roll
   32768 div add         % compute x location
   2t astore pop        % save 'em
} def

/3a [0 0 0] def
/2t 2 array def

% store transformation params: "justify flip rotation tp"
% (left/center/right/full, none/yflip,xflip, degrees)
/tp{
   3a astore pop
} def
/ee {} def

% move PostScript current position to QuickDraw current position,
% and get scaling and rotation right (this is in preparation for
% outputting text
/tt {
   gsave
     currentpoint 2 copy
     2t aload pop qa 2 copy xl
     3a aload pop exch dup 0 eq
     {pop}
     {1 eq {-1 1}
           {1 -1}ifelse scale}
     ifelse
     rotate
     pop neg exch neg exch xl
     moveto
} def

/te {                % text-end: undo effects of prior "tt"
   currentpoint currentfont
   grestore setfont moveto    % but leave font and currentpoint set
} def

/tb {
   /tg currentgray def
   3 -1 roll 3 eq
   {1 setgray} if
   /ml 0 def /al 0 def
} def

/am {
   ml add /ml xdf
} def

/aa {
   [currentgray /setgray cvx] cvx
   exch dup wi pop dup al add /al xdf exch
} def

% scale by rational value (quotient) in x and y. Set "scaleflag" to
% record that we have done this.

/th {
   3 -1 roll div
   3 1 roll exch div
% not sure of "transform" in next line (BKR)
   2 copy matrix1 transform scale
   pop scale
   /scaleflag true def
} def

% undo a "th" scaling and return to default coordinate system
/tu {
   1 1 matrix1 itransform scale
   /scaleflag false def
} def

/ts {
   1 1 matrix1 transform scale
   /scaleflag true def
} def

% record point size (of fonts)
/fz{/ps xdf} def

% execute a procedure but leave it on the stack
/fx{dup exec} def

/st{show pop pop} def

% text munger. This does the dirty work for the edit string procedure
% (following) by iterating over a polymorphic array and doing the right
% thing with what it finds there.
/tm {
      {dup type dup /integertype eq exch /realtype eq or
         {dup ml mul}
         {dup type /stringtype eq
            {rs}
            {dup type /dicttype eq
               {setfont}
               {dup type /arraytype eq
                  {exec}
                  {pop}
          ifelse
               } ifelse
            } ifelse
         } ifelse
      } forall
   } def

% edit string. Takes a font, a text mode, a justification mode, and an
% array of text and font changes for that text, and does it.
/es {
   3 -1 roll dup sa 5 get dup type /nulltype eq
   {pop4 pop}
   {sa 1 get
      {/ml ml .2 ps mul sub def} if
      ne {fs}
         {pop}
      ifelse exch
      dup 1 eq            % justification mode 1 is left-justify
      {pop
         al ml gt
     {/tv {ll} /ml ml al dup 0 ne
        {div}{pop} ifelse
     def}
     {/tv {st} /ml 1 def}
     ifelse def tm
      }
      {dup 3 eq            % justification mode 3 is right-justify
      {pop
      al ml gt
      {/tv {ll} /ml ml al dup 0 ne
        {div}{pop} ifelse
        def}
      {ml al sub 0 rmoveto
        /tv {st} /ml 1 def}
      ifelse def
         tm}
      {2 eq            % justification mode 3 is centered
      {al ml gt
         { /tv {ll} /ml ml al dup
       0 ne
       {div}{pop}
       ifelse def}
     {ml al sub 2 div 0 rmoveto
       /tv {st} /ml 1 def}
       ifelse def
         tm}
      {                % otherwise it is just "justified"
        /tv {ll} def
        /ml ml al dup 0 ne
      {div}{pop}
      ifelse def
         tm}
       ifelse}
     ifelse}
   ifelse}
   ifelse
   tg setgray
}def

/pop4 {pop pop pop pop} def
% --------------------------------------------------------------------
%              QuickDraw Procedures
%
% moveto. If a scale factor is in effect, then honor it.
/gm {
  scaleflag {matrix1 itransform} if
  moveto
} def

%local y move
% call: "x y localy ly"
/ly {
   exch pop
   currentpoint exch pop
   sub 0 exch rmoveto
} def

% print n copies of page  (ensures full speed for multiple copies)
/page {
   1 add /#copies xdf showpage
} def

/sk {
   systemdict /statusdict known
} def

% set job name
/jn {
   sk {statusdict /jobname 3 -1 roll put}
      {pop}
   ifelse
} def

% set pen size: h v pen
/pen {
   /pnsv xdf
   /pnsh xdf
   pnsh setlinewidth
} def

% draw line
% (uses current pen location, pen size and graylevel)
% This emulates the ugly QuickDraw pen on the LaserWriter but
% preserves the same endpoint and linewidth anomalies that some applications
% rely on. (Bletch).
/dlin {
   currentpoint newpath moveto
   lineto currentpoint stroke
   grestore moveto
} def

/lin {
   currentpoint /pnlv xdf /pnlh xdf
   gsave newpath /@y xdf /@x xdf fp
   {pnlh @x lt
      {pnlv @y ge
         {pnlh pnlv moveto @x @y lineto
      pnsh 0 rlineto
          0 pnsv rlineto
      pnlh pnsh add pnlv pnsv add lineto
      pnsh neg 0 rlineto}
         {pnlh pnlv moveto
      pnsh 0 rlineto
      @x pnsh add @y lineto
      0 pnsv rlineto
          pnsh neg 0 rlineto
      pnlh pnlv pnsv add lineto}
     ifelse}
      {pnlv @y gt
         {@x @y moveto pnsh 0 rlineto
       pnlh pnsh add pnlv lineto
      0 pnsv rlineto
          pnsh neg 0 rlineto
      @x @y pnsv add lineto}
     {pnlh pnlv moveto pnsh 0 rlineto
          0 pnsv rlineto
      @x pnsh add @y pnsv add lineto
      pnsh neg 0 rlineto
          0 pnsv neg rlineto}
     ifelse}
      ifelse
      closepath fill}
   if @x @y grestore moveto
} def

/dl {
   gsave
   0 setlinewidth 0 setgray
} def

% Arc: top left bottom right startangle stopangle verb flag
% flag true means to exclude the center of curvature in the arc
/barc {
   /@f xdf   /@op xdf   /@e xdf   /@s xdf
   /@r xdf   /@b xdf    /@l xdf   /@t xdf
   gsave
   @r @l add 2 div @b @t add 2 div xl 0 0 moveto
   @r @l sub @b @t sub mtx currentmatrix pop scale
   @f {newpath} if
   0 0 0.5 @s @e arc
   mtx setmatrix @op doop
   grestore
} def
/doarc {dup 0 eq barc} def

% oval:  top left bottom right verb
/doval {0 exch 360 exch true barc} def

% rectangle:  top left bottom right verb
/dorect {
   /@op xdf currentpoint 6 2 roll
   newpath 4 copy
   4 2 roll exch moveto
   6 -1 roll lineto
   lineto lineto closepath
   @op doop moveto
} def

/mup {dup pnsh 2 div le exch pnsv 2 div le or} def

% roundrect:  top left bottom right ovalwidth ovalheight operation
% Warning: ovalwidth is assumed equal to ovalheight.
/dorrect {
   /@op xdf     2. div /@h xdf     2. div /@w xdf
   /@r xdf      /@b xdf            /@l xdf /@t xdf
   @t @b eq @l @r eq @w mup or or
   {@t @l @b @r @op dorect}
   {@r @l sub 2. div dup @w lt
      {/@w xdf}{pop}
      ifelse
      @b @t sub 2. div dup @w lt
      {/@w xdf}{pop}
      ifelse
      @op 0 eq
      {/@w @w pnsh 2 div sub def}
      if            %this helps solve overlap gap for wide line widths
      currentpoint
      newpath
      @r @l add 2. div @t moveto
      @r @t @r @b @w arcto pop4
      @r @b @l @b @w arcto pop4
      @l @b @l @t @w arcto pop4
      @l @t @r @t @w arcto pop4
      closepath @op doop
      moveto
   }ifelse
} def

% Polygon utility procedures
/pr {
   gsave newpath /pl
      {moveto
       /pl {lineto} def
      }def
} def

/pl {lineto} def

/ep {
   dup 0 eq
    {
     {moveto}{lin}{}{}
     pathforall %nothing but movetos and linetos should be called
     pop grestore
    }
    {
     doop grestore
    }
    ifelse
} def

/bs 8 string def
/bd {/bs xdf} def



% These following procedures are used in defining QuickDraw patterns.
% (Pattern definition goes into halftone screen of PostScript)

% procedure to find black bits in QuickDraw pattern (pattern in hex string bs)
/bit {bs exch get exch 7 sub bitshift 1 and} def
/bix {1 add 4 mul cvi} def
/pp{exch bix exch bix bit}def
/grlevel {64. div setgray} def


% procedure to set a pattern: ratio hexstring
% ratio is the total number of white bits in the QuickDraw pattern represented in hexstring

/setpat {
   /bs xdf
   9.375 0 {pp} setscreen
   grlevel
} def

/setgry {
   freq rot {spf} setscreen
   grlevel
} def

% standard copybits routine:
% arguments: xscale yscale xloc yloc rowbytes xwidth ywidth fsmooth bitmode
% This procedure is the basis for all QuickDraw bit operations.
% xscale and yscale tell how much to scale the bit image in 72nds of an inch
% xloc and yloc are the location of the top left corner of the bitmap
% rowbytes is the total number of bytes in each scanline of hex data in the
% image.
%    Note that rowbytes must be even.
% xwidth and ywidth are the actual number of bits in the x and y coordinates
% of the image. fsmooth is a flag to tell whether or not to use bit
% smoothing.  Bit smoothing is a
% proprietary algorithm that provides smoothing of the data around a 5 by 5
% local area of each data pixel.
% bitmode can be any of the QuickDraw source transfer modes excluding srcXor
% and notSrcXor.
%    Note that this is the only QuickDraw procedure that can implement
% more than the simple srcCopy transfer mode.

/x4 {2 bitshift} def
/d4 {-2 bitshift} def
/xf {.96 mul exch 2 sub .96 mul exch} def
/dobits
{
   /bmode xdf
   save 9 1 roll
% 2 sub fixes dxsrc offset number required for bitsmoothing, but applies
% to both

%Bit Smooth mode
   {
   x4 /@dy xdf 2 sub x4 /@dx xdf /@idx xdf
   .96 mul exch 3 index 2 sub @dx div 7.68 mul dup 6 1 roll sub exch xl 0 0 moveto xf
   0 4 -1 roll 2 index 4 index 1.759 add 10 dorect clip newpath 0 0 moveto scale
   bmode 0 eq bmode 4 eq or{1 setgray 1 @dy div 1 @dx div 1 1 2 dorect}if
   bmode 3 eq bmode 7 eq or{1}{0}ifelse setgray
   @idx 5 bitshift @dy bmode 0 eq bmode 1 eq bmode 3 eq or or [@dx 0 0 @dy 0 0]
     {(%stdin)(r) file @dy d4 4 add @idx mul string readhexstring pop
     dup length @idx x4 sub 4 bitshift string
     dup 3 1 roll @dx 8 add d4 smooth} imagemask
   }
%Non Bit Smooth mode
   {
   /@dy xdf 2 sub /@dx xdf /@idx xdf
   /@xs @idx string def
   /@f (%stdin)(r) file def
   /@p{@f @xs readhexstring pop}def
   .96 mul xl 0 0 moveto xf scale
   0 0 1 1 10 dorect clip newpath 0 0 moveto
   bmode 0 eq bmode 4 eq or{1 setgray .25 @dy div .25 @dx div 1 1 2 dorect}if
   bmode 3 eq bmode 7 eq or{1}{0}ifelse setgray
   @p @p
   @idx 3 bitshift @dy bmode 0 eq bmode 1 eq bmode 3 eq or or [@dx 0 0 @dy 0 0]
   {@p} imagemask
   @p @p pop4
   }ifelse
restore
} def


% Making Mac compatible Fonts


/mfont 14 dict def
/wd 14 dict def
/mdef {mfont wcheck not{/mfont 14 dict def}if mfont begin xdf end} def
/dc {transform round .5 sub exch round .5 sub exch itransform} def


% Copy a font dictionary: fontdictionary
% copies a font dictionary into tmp so it may be used to define a new font

% tmp must be set before cf is called
/cf{{1 index /FID ne {tmp 3 1 roll put}{pop pop}ifelse}forall}def


% Procedures used in defining a bit map font

/mv{tmp /Encoding macvec put}def
/bf{
mfont begin
/FontType 3 def
/FontMatrix [1 0 0 1 0 0] def
/FontBBox [0 0 1 1] def
/Encoding macvec def
/BuildChar
  {
  wd begin
    /cr xdf
    /fd xdf
    fd /low get cr get 2 get -1 ne
    {
    fd begin
      low cr get aload pop
      sd
      low cr 1 add get 0 get
      sh
      sw
    end
    /sw xdf
    /sh xdf
    sw div /clocn xdf
    dup 0 ne {0 exch sh div neg dc xl}{pop}ifelse
    exch sw div /coff xdf
    exch sw div /cloc xdf
    /bitw clocn cloc sub def
    sw sh div 1 scale
    sw div 0 coff 0 bitw coff add 1 setcachedevice
    coff cloc sub 0 dc xl
    cloc .5 sw div add 0 dc newpath moveto
    bitw 0 ne
      {0 1 rlineto bitw .5 sw div sub 0 rlineto 0 -1 rlineto
        closepath clip
      sw sh false [sw 0 0 sh neg 0 sh]{fd /hm get}imagemask}if
    } if
  end
  } def
end
mfont definefont pop
} def


% stringwidth procedure which does not allow a show to occur: (string)

/wi{save exch /show{pop}def
stringwidth 3 -1 roll restore}def

/aps {0 get 124 eq}def
/apn {s30 cvs aps} def


%set style in a PostScript name: AppleFontName
% e.g.
% /|----name sos /|---Oname
% /|----name sis /|-I--name

/xc{s30 cvs dup}def
/xp{put cvn}def
/scs{xc 3 67 put dup 0 95 xp}def
/sos{xc 3 79 xp}def
/sbs{xc 1 66 xp}def
/sis{xc 2 73 xp}def
/sob{xc 2 79 xp}def
/sss{xc 4 83 xp}def

/dd{exch 1 index add 3 1 roll add exch} def
/smc{moveto dup show} def
/kwn{dup FontDirectory exch known{findfont exch pop}}def
/fb{/ps ps 1 add def}def
/mb
{dup sbs kwn
   {
   exch{pop}{bbc}{} mm
   }ifelse
sfd
}def
/mo
{dup sos kwn
   {
   exch{pop}{boc}{} mm
   }ifelse
sfd
}def
/ms
{dup sss kwn
   {
   exch{pop}{bsc}{} mm
   }ifelse
sfd
}def

/ao
{dup sos kwn
   {
   exch dup ac pop
   {scs findfont /df2 xdf}{aoc}{} mm
   }ifelse
sfd
}def

/as
{dup sss kwn
   {
   exch dup ac pop
   {scs findfont /df2 xdf}{asc}{} mm
   }ifelse
sfd
}def

/ac
   {
   dup scs kwn
      {exch /ofd exch findfont def
      /tmp ofd maxlength 1 add dict def
      ofd cf mv
      tmp /PaintType 1 put
      tmp definefont}ifelse
   }def

/mm{
/mfont 10 dict def
mfont begin
/FontMatrix [1 0 0 1 0 0] def
/FontType 3 def
/Encoding macvec def
/df 4 index findfont def
/FontBBox [0 0 1 1] def
/xda xdf
/mbc xdf
/BuildChar { wd begin
  /cr xdf
  /fd xdf
  /cs s1 dup 0 cr put def
  fd /mbc get exec
  end
} def
exec
end
mfont definefont} def
/bbc
{
  /da .03 def
  fd /df get setfont
  gsave
    cs wi exch da add exchd
  grestore
  setcharwidth
  cs 0 0 smc
    da 0 smc
    da da smc
     0 da moveto show
} def

/boc
{
  /da 1 ps div def
  fd /df get setfont
  gsave
    cs wi
    exch da add exch
  grestore
  setcharwidth
  cs 0 0 smc
    da 0 smc
    da da smc
     0 da smc
  1 setgray
     da 2. div dup moveto show
} def

/bsc
{
  /da 1 ps div def
  /ds .05 def %da dup .03 lt {pop .03}if def
  /da2 da 2. div def
  fd /df get setfont
  gsave
    cs wi
    exch ds add da2 add exch
  grestore
  setcharwidth
  cs ds da2 add .01 add 0 smc
      0 ds da2 sub xl
      0  0 smc
     da  0 smc
     da da smc
      0 da smc
  1 setgray
      da 2. div dup moveto show
} def
/aoc
{
  fd /df get setfont
  gsave
    cs wi
  grestore
  setcharwidth
  1 setgray
  cs 0 0 smc
  fd /df2 get setfont
  0 setgray
  0 0 moveto show
}def
/asc
{
  /da .05 def
  fd /df get setfont
  gsave
    cs wi
    exch da add exch
  grestore
  setcharwidth
  cs da .01 add 0 smc
      0 da xl
  1 setgray
      0 0 smc
  0 setgray
  fd /df2 get setfont
      0 0 moveto show
}def

/T true def
/F false def


% More Polygon stuff used in polygon comment

/6a 6 array def
/2a 2 array def
/5a 5 array def
%subtract points, first from second (reverse order):  pt0 pt1 qs newpt
/qs{3 -1 roll sub exch 3 -1 roll sub exch}def
/qa{3 -1 roll add exch 3 -1 roll add exch}def
%multiply point: pt factor qm newpt
/qm{3 -1 roll 1 index mul 3 1 roll mul}def
/qn{6a exch get mul}def
/qA .166667 def /qB .833333 def /qC .5 def
/qx{
   6a astore pop
   qA 0 qn qB 2 qn add  qA 1 qn qB 3 qn add
   qB 2 qn qA 4 qn add  qB 3 qn qA 5 qn add
   qC 2 qn qC 4 qn add  qC 3 qn qC 5 qn add
}def
/qp{6 copy 12 -2 roll pop pop}def
/qc{qp qx curveto}def
/qi{{4 copy 2a astore aload pop qa .5 qm newpath moveto}{2 copy 6 -2 roll 2 qm qs 4 2 roll}ifelse}def
/qq{{qc 2a aload pop qx curveto}{4 copy qs qa qx curveto}ifelse}def

%start polygon comment
/pt{gsave currentpoint newpath moveto}def

%fill smoothed poly
/qf{gsave eofill grestore}def
/tr{currentgray currentscreen bs 5a astore pop /fillflag 1 def}def
/bc{/fillflag 0 def}def

%polyverb ec
/ec{currentpoint 3 -1 roll
   1 and 0 ne
   {currentgray currentscreen bs 5a aload pop bd setscreen setgray 0 doop bd setscreen setgray}
   {newpath}ifelse
   moveto
}def

/bp {
   currentpoint newpath 2 copy moveto
   currentgray currentscreen bs 5a astore pop
} def

/eu{
   fillflag 0 ne
   {
   gsave currentgray currentscreen bs
   5a aload pop bd setscreen setgray
   4 ep
   bd setscreen setgray
   }if
   fp{0 ep}{grestore newpath}ifelse
}def


% Line Layout stuff used by string merging algorithm

% counts spaces in string:   (...) sm (...) n
% returns string and number of spaces in string

/sm
{
dup 0 exch
{32 eq{1 add}if}forall
}
def


% layout a string to length specified by desiredlength:  printerlength desiredlength (...) ll
% printerlength is length of string in printer space

/ll
{
3 1 roll exch dup .0001 lt 1 index -.0001 gt and
{pop pop pop}
{sub dup 0 eq
   {
   pop show
   }
   {
   1 index sm dup 0 eq 3 index 0 le or
      {
      pop length div
      0 3 -1 roll ashow
      }
      {
% This piece does 10 percent stretching in characters and 90 percent in spaces
      10 mul exch length add div
      dup 10 mul 0 32 4 -1 roll 0 6 -1 roll awidthshow
% This piece does straight stretching in spaces only
%      exch pop div
%      0 32 4 -1 roll widthshow
      }ifelse
   }ifelse
}ifelse
}def


%set font to symbol and show the string: (...) ss

/ss
{  /pft currentfont def sa aload pop pop /|----2Symbol 4 1 roll
   {pop{as}}
   {{{ao}}{{fnt}}ifelse}ifelse
   exch pop exec exch pop
}def
/pf{pft dup setfont}def


% regular show does underline if ulf is true:
% arguments: printerlength desiredlength string rs

/rs
{
   sa 2 get
   {
   gsave
   1 index 0
   currentfont
   dup /FontInfo known
      {
      /FontInfo get
      dup /UnderlinePosition known
         {
         dup /UnderlinePosition get 1000 div ps mul
         }
         {
         ps 10 div neg  %15 makes line closer to text
         }ifelse
      exch
      dup /UnderlineThickness known
         {
         /UnderlineThickness get 1000 div ps mul
         }
         {
         pop
         ps 15 div  %20 makes slightly narrower line
         }ifelse
      }
      {
      pop
      ps 10 div neg   %15 makes line closer to text
      ps 15 div       %20 makes slightly narrower line
      }ifelse
   setlinewidth
   0 setgray
   currentpoint 3 -1 roll sub moveto
   sa 4 get{gsave currentlinewidth 2. div dup rmoveto currentpoint xl 2 copy rlineto
   stroke grestore}if
   sa 3 get sa 4 get or 3 1 roll 2 index{gsave 1 setgray 2 copy rlineto stroke grestore}if
   rlineto{strokepath 0 setlinewidth}if stroke
   grestore
   }if
   tv
}
def


%  More Font building stuff, specifically the Apple Encoding Vector

% Font encoding vector for PostScript fonts to match Mac
/macvec 256 array def
macvec 0
/Times-Roman findfont /Encoding get
0 128 getinterval putinterval macvec 39 /quotesingle put
 /dotlessi /grave /circumflex /tilde /cedilla /registerserif
 /copyrightserif /trademarkserif
macvec 0 8 getinterval astore pop
 /Adieresis /Aring /Ccedilla /Eacute /Ntilde /Odieresis /Udieresis /aacute
 /agrave /acircumflex /adieresis /atilde /aring /ccedilla /eacute /egrave
 /ecircumflex /edieresis /iacute /igrave /icircumflex /idieresis /ntilde
 /oacute  /ograve /ocircumflex /odieresis /otilde /uacute /ugrave
 /ucircumflex /udieresis
 /dagger /ring /cent /sterling /section /bullet /paragraph /germandbls
 /registersans /copyrightsans /trademarksans /acute /dieresis /notequal
 /AE /Oslash
 /infinity /plusminus /lessequal /greaterequal /yen /mu /partialdiff
 /summation
 /product /pi /integral /ordfeminine /ordmasculine /Omega /ae /oslash
 /questiondown /exclamdown /logicalnot /radical /florin /approxequal /Delta
 /guillemotleft  /guillemotright /ellipsis /space /Agrave /Atilde /Otilde
 /OE /oe /endash /emdash /quotedblleft /quotedblright /quoteleft
 /quoteright /divide /lozenge /ydieresis /Ydieresis /fraction /currency
 /guilsinglleft /guilsinglright /fi /fl /daggerdbl /periodcentered
 /quotesinglbase /quotedblbase /perthousand /Acircumflex /Ecircumflex /Aacute
 /Edieresis /Egrave /Iacute /Icircumflex /Idieresis /Igrave /Oacute
 /Ocircumflex /apple /Ograve /Uacute /Ucircumflex /Ugrave /dotlessi
 /asciicircum /asciitilde /macron /breve /dotaccent /ring /cedilla
 /hungarumlaut /ogonek /caron
macvec 128 128 getinterval astore pop

% now redefine all fonts using the MAC Encoding (except in Symbol) to make
% them be Apple compatible.

FontDirectory
{exch dup s30 cvs /@s xdf @s aps
   {pop pop}
   {exch dup length dict /tmp xdf
      cf
      /Symbol ne {mv} if
      /@i false def /@o false def /@b false def
      mark @s (Italic) search {/@i true def} if (Oblique) search {/@o true def} if
      (Bold) search {/@b true def} if (Roman) search pop (-) search pop /@s xdf cleartomark
      @s cvn dup /Symbol eq{pop 50}{/Courier eq{51}{49}ifelse}ifelse
      s30 0 @s length 6 add getinterval dup 6 @s putinterval dup 0 (|-----) putinterval
      @b {dup 1 66 put} if @i @o or {dup 2 73 put} if % @o {dup 2 79 put} if
      dup 5 4 -1 roll put
      cvn tmp definefont pop
   }ifelse
}forall


%Make any other special fonts here, i.e. Seattle

/_--C-2Symbol /Symbol findfont /tmp 1 index maxlength 1 add dict def cf tmp /PaintType 1 put tmp definefont
/|----4Seattle /Helvetica findfont dup length 1 add dict /tmp xdf cf mv
/mxv [/zero /one /two /three /four /five /six /seven /eight /nine /comma /period /dollar /numbersign
/percent /plus /hyphen /E /parenleft /parenright /space] def
tmp /Metrics 21 dict dup begin mxv{600 def}forall end put
tmp begin /FontBBox FontBBox [0 0 0 0] astore def end
tmp definefont pop


% open document, open page and close page procedures
% close document doesn't do anything currently

% txpose takes the vertical page size as a parameter
/od{txpose 10 fz 0 fs F /|----3Courier fnt pop}def
/op{/scaleflag false def /pm save def}def
/cp{pm restore}def

end